perm filename NEW.OLD[XX,LCS]1 blob
sn#208663 filedate 1976-03-26 generic text, type T, neo UTF8
00100 TITLE BMSTF ;0300 SUBROUTINE BMSTF
00110 ENTRY BMSTF
00120 EXTERNAL STAFF,RHORZ,AMOD,NOZERO,IFIX,LINES,BMS,MAKNUM
00130 EXTERNAL .COMM.,ALF,POSI,STF,MIN,BM,PLTR
00200 BMSTF: 0 ;00400 IMPLICIT INTEGER(A-Q,S-Z)
00300 ;00500 REAL DIS,DISX,HGT,POS,CENTR,STFF,HGT1
00400 ;00600 COMMON/STF/RSTFAC(-3/4),RSTJ2/MIN/MINI,RMINI
00500 ;00700 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/BM/RA,RC,RJY
00600 ;00800 COMMON/POSI/STFF(-3/4),JJ2,POS/PLTR/PLT,RHT,DIS
00700 ;00900 COMMON/ALF/QQ(3),RST7,RST18,R3Q,JY,RD,RX,RW,RJX,RJ,L,K,
00800 ;01000 1 RJA,YY,DISX,HGT,RZ,INP(53)
00900 ;01100 EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3))
01000 ;01200 1,(R6,RJQ(4)),(J7,JQ(5)),(J8,JQ(6)),(J9,JQ(7)),(J10,JQ(8))
01100 ;01300 1,(J11,JQ(9)),(J6,JQ(4)),(R9,RJQ(7)),(R8,RJQ(6)),(R3,RJQ(1
01200 ;01400 1 ,(R7,RJQ(5)),(R4,RJQ(2)),(R9,RJQ(7)),(R10,RJQ(8)),(RX3,R
01300 ;01500 DATA R14/14.54/,RTF/3.0/,RHGT/48.0/,R2HGT/96.0/,RBM/.83/
01400 ;01600 C RDBR IS SPACER FOR DBL BAR.
01600 ; 01710 IF(JA.NE.8)GO TO 100
01700 MOVEI 02,10
01800 CAME 02,.COMM.+1
01900 JRST BS100
02000 ; 01720 CALL STAFF
02100 JSA 16,STAFF
02200 JRA 16,(16) ;1730 RETURN
02400 ; 02000 C TO COMPENSATE FOR NOTE #3 COMING AT POS=0
02500 ; 02200 R3Q=R3
02600 BS100: MOVE 02,.COMM.+4
02700 MOVEM 02,ALF+5
02800 ; 02400 C NEXT IS FOR BEAMS
02900 ; 02500 RMINI=RSTJ2
03000 MOVE 02,STF+=8
03100 MOVEM 02,MIN+1
03200 ; 02600 RX=2.7*RSTJ2*5.96
03300 FMPR 02,[16.092]
03400 MOVEM 02,ALF+=8
03410 MOVE 5,.COMM.+=10 ; SAVE R9 IN 5
03420 MOVE 6,.COMM.+=28 ; 6 IS J7
03500 ;; 02800 R6=RHORZ(R6)
03600 JSA 16,RHORZ
03700 JUMP .COMM.+7
03800 MOVEM 00,.COMM.+7
04000 MOVSI 2,204500 ; (10.0) IF(R8.NE.0)GO TO 204
04100 SKIPN .COMM.+=9
04200 CAMG 2,.COMM.+=11
04210 JRST BS204 ; IF(R10.GE.10)GO TO 204
04900 ; 03100 IF(J7)GO TO 204
05100 JUMPL 6,BS204
05300 ; 03200 IF(R9.NE.0)GO TO 1
05500 JUMPN 5,BS1
05700 ; R8=0 AND R9=NUM -- PUTS NUMBER OUTSIDE BEAM(FOR TRIPLET
05900 ; 03400 204 IF(R9.NE.0)R9=RHORZ(R9)
06400 BS204: JUMPE 5,.+4
06500 JSA 16,RHORZ
06600 JUMP .COMM.+=10
06700 MOVEM .COMM.+=10
06900 JUMPL 6,BS201 ; IF(J7)GO TO 201
07500 BS200: MOVEI 02,12 ; 200 IF(J10.LT.10)GO TO 91
07600 CAMLE 02,.COMM.+=31
07700 JRST BS91
07900 ; 03700 C NEXT FOR INNER, PARTIAL BEAMS
08100 ; 03800 R8=RHORZ(R8)
08200 JSA 16,RHORZ
08300 JUMP .COMM.+=9
08400 MOVEM 00,.COMM.+=9
08600 ; 03900 R10=AMOD(R10,10.)
08700 JSA 16,AMOD
08800 JUMP .COMM.+=11
08900 JUMP [10.0]
09000 MOVEM 00,.COMM.+=11
09200 ; 04000 GO TO(2,3,4),.COMM.+=31/10
09300 MOVE 02,.COMM.+=31
09400 IDIVI 02,12
09500 SKIPLE 01,2
09600 CAILE 01,3
09700 SKIPA 0
09800 M4: JRST @M4 (1)
09900 JUMP 00,BS2
10000 JUMP 00,BS3
10100 JUMP 00,BS4
10300 ; 04100 2 RH=R9+RX
10400 BS2: MOVE 02,ALF+=8
10500 FADR 02,.COMM.+=10
10600 MOVEM 02,RH#
10800 ; 04200 GO TO 1
10900 JRST BS1
11100 ; 04300 3 R8=R9-RX
11200 BS3: MOVN 02,ALF+=8
11600 FADR 02,.COMM.+=10
11700 MOVEM 02,.COMM.+=9;10=SHRT PARTIAL LFT↑RT., 20=RT.↑LFT, 30=TO POS IN P8
12100 ; 04500 4 RH=R8
12200 BS4: MOVE 02,.COMM.+=9
12300 MOVEM 02,RH
12500 ; 04600 C LEFT INNER POS.
12700 ; 04700 GO TO 1
12800 JRST BS1
13000 ; 04800 201 J7=-J7
13100 BS201: MOVNS 00,.COMM.+=28
13300 ; 04900 C P8=WIDTH OF TREM. P9=0(SANS OTHER BEAMS) OR =POS.3, P10=D
13500 ; 05000 CALL NOZERO(R10)
13600 JSA 16,NOZERO
13700 JUMP .COMM.+=11
13900 ; 05100 C ALWAYS AT LEAST 1 IN DISPLACEMENT
14100 ; 05200 J10=30
14200 MOVEI 02,36
14300 MOVEM 02,.COMM.+=31 ; TO ACTIVATE PARTIAL BEAM SECTION
14700 ; 05400 IF(J9.NE.0)GO TO 202
14800 MOVE 02,.COMM.+=30
14900 JUMPN 02,BS202
15100 ; 05500 C NEXT FOR TREM. WITHOUT OTHER BEAMS.
15300 ; 05600 RH=-1
15400 MOVSI 02,576400
15500 MOVEM 02,RH
15700 ; 05700 IF(J7.GE.20)RH=-RH
15800 MOVEI 02,24
15900 CAML 02,.COMM.+=28
16100 MOVNS 00,RH
17100 ; 06000 R5=R4+RH
17200 MOVE 02,RH
17300 FADR 02,.COMM.+5
17400 MOVEM 02,.COMM.+6
17600 ; 06100 R9=R3
17700 MOVE 02,.COMM.+4
17800 MOVEM 02,.COMM.+=10
18000 ; 06200 R6=R3+22.*RMINI
18100 MOVSI 02,205540
18200 FMPR 02,MIN+1
18300 FADR 02,.COMM.+4
18400 MOVEM 02,.COMM.+7
18600 ; 06300 202 IF(R8.EQ.0)R8=4.
18700 BS202: MOVE 02,.COMM.+=9
18800 JUMPN 02,.+3
18900 MOVSI 02,203400
19000 MOVEM 02,.COMM.+=9
19300 ; 06400 RX=R8*RMINI*2.98
19400 FMPR 02,MIN+1
19600 FMPR 02,[2.98]
19700 MOVEM 02,ALF+=8
19900 ; 06500 RH=R9+RX
20000 MOVE 02,ALF+=8
20100 FADR 02,.COMM.+=10
20200 MOVEM 02,RH
20400 ; 06600 R9=R9-RX
20500 MOVN 02,ALF+=8
20600 FADRM 02,.COMM.+=10
20800 ; 06700 GO TO 1
20900 JRST BS1
21400 BS91: MOVE 3,.COMM.+=29 ; 91 IF(J8.EQ.0)GO TO 1
21500 JUMPE 3,BS1
22200 JUMPG 3,BS92 ; IF(J8.GT.0)GO TO 92
22400 ; FOR J8=-(10+DN) OR -(20+DN) R9=R3+RX
22700 MOVE 02,.COMM.+4
22800 FADR 02,ALF+=8 ; IF(J8.LE.-20)R9=R6-RX
23300 CAMLE 3,[-=20]
23400 JRST .+3
23500 MOVN 02,ALF+=8
23600 FADR 02,.COMM.+7
23700 MOVEM 02,.COMM.+=10
24000 ; 07400 192 J8=-J8
24100 BS192: MOVNS 00,.COMM.+=29
24300 ; 07500 92 IF(J10.EQ.0)J10=MOD(J8,10)
24400 BS92: MOVE 02,.COMM.+=31
24500 JUMPN 02,.+3
24600 MOVE 1,.COMM.+=29
24700 IDIVI 1,=10 ; IF(J10.EQ.0)J10=1
25600 SKIPN 02
25700 MOVEI 02,1
25800 MOVEM 02,.COMM.+=31 ; R10=J10
26200 ;; MOVE 1,.COMM.+=31
26300 TLC 2,232000
26350 FADR 2,2
26400 MOVEM 2,.COMM.+=11 ;IF P8 NEG, P9 IS AUTOMATIC, ALSO P10 IF NEEDED.
26800 ; 08000 1 IF(IABS(J4).LT.100)GO TO 97
26900 BS1: MOVM .COMM.+=25
27100 CAIGE 00,144
27500 JRST BS97
27700 ; 08100 RMINI=.6*RSTJ2
27800 MOVE 02,[0.6]
27900 FMPR 02,STF+=8
28000 MOVEM 02,MIN+1
28200 ; 08200 R5=AMOD(R5,100.0)
28300 JSA 16,AMOD
28400 JUMP .COMM.+6
28500 JUMP [100.0]
28600 MOVEM 00,.COMM.+6 ; SPACE BETWEEN BEAMS
29000 ; 08400 97 RJ=RMINI*11.
29100 BS97: MOVSI 2,204540
29200 FMPR 2,MIN+1
29300 MOVEM 2,ALF+=11
29400 MOVSI 206600 ;MOVE [48.0] ;RW=RMINI*RHGT
29500 FMPR MIN+1
29600 MOVEM ALF+=9 ; DIST. UP OR DOWN FROM NOTE HEAD.
29700 FMPR 2,.COMM.+=11 ;RJA=R10*RJ
29750 MOVEM 2,ALF+=14 ; DISPLACEMENT
29800 MOVE .COMM.+=10 ; RD=R9
29900 MOVEM ALF+7 ; POSITION 3
31600 FSBR 2,ALF+=9
31800 FADR 02,.COMM.+2 ; RJX=CENTR-RW+RJA
31900 MOVEM 02,ALF+=10 ; FINAL HEIGHT OF LEFT SIDE
32300 ; 09300 C NEG R7=TREMOLO
32800 ; 09400 RX=MOD(J7,10)
32900 MOVE .COMM.+=28
33000 IDIVI =10
33100 TLC 1,232000
33200 FADR 1,1
33300 MOVEM 1,RX#
33700 ; 09500 JJ2=J7-20
33800 MOVNI 02,24
33900 ADD 02,.COMM.+=28
34000 MOVEM 02,POSI+=8
34200 ; 09600 RA=R6
34300 MOVE 02,.COMM.+7
34400 MOVEM 02,BM ; HORIZANTAL DIST.
34800 ; RJY=R5*RST7+POS-RST18-RW+RJA
34900 MOVSI 3,203700 ; 7.0
35000 FMPR 03,.COMM.+6
35050 FSBR 3,[18.0]
35060 FMPR 3,STF+=8
35100 FADR 3,ALF+=14
35200 FADR 3,POSI+=9
35250 FSBR 3,ALF+=9
35600 MOVEM 3,BM+2 ; VERTICAL POS OF RIGHT SIDE.
36300 ; 10000 RW=R14*RMINI
36400 MOVE 4,[14.54]
36500 FMPR 4,MIN+1
36600 MOVEM 4,ALF+=9
36800 ; 10100 RY=1.
36900 MOVSI 02,201400
37000 MOVEM 02,RY#
37200 ; 10200 IF(J7.GE.20)GO TO 98
37300 MOVEI 02,24
37400 CAMG 02,.COMM.+=28
37500 JRST BS98 ; JUMP IF STEMS ARE DOWN
37900 ; 10400 RY=-RY
38000 MOVNS 00,RY
38500 ; 10500 C FOR THICKENING INCR.
38700 ; 10600 JJ2=J7-10
38800 MOVNI 02,12
38900 ADD 02,.COMM.+=28
39000 MOVEM 02,POSI+=8
39200 ; 10700 RJ=-RJ
39300 MOVNS 00,ALF+=11
39500 ; 10800 RJA=RMINI*R2HGT-2.*RJA
39600 MOVE 02,[96.0]
39700 FMPR 02,MIN+1
39800 MOVE 03,ALF+=14
39900 FSC 03,1
40000 FSBR 02,3
40100 MOVEM 02,ALF+=14
40300 ; 10900 RJX=RJX+RJA
40500 FADRM 02,ALF+=10
40700 ; 11000 RJY=RJY+RJA
40900 FADRM 02,BM+2
41100 ; 11100 R3Q=R3Q+RW
41300 FADRM 4,ALF+5 ; POSITION 1
41700 ; 11300 RA=RA+RW
41900 FADRM 4,BM ; POSITION 2
42300 ; 11500 RD=RD+RW
42500 FADRM 4,ALF+7
42900 ; 11700 RH=RH+RW
43100 FADRM 4,RH
43300 ; 11800 98 RSTJ2=RSTJ2*RBM
43700 BS98: MOVE 02,[0.83]
43800 FMPRM 02,STF+=8
44000 ; RBM BRINGS LINES OF BEAMS CLOSER TOGETHER. (=.83)
44200 ; 12000 93 IF(JJ2.GT.RX)GO TO 94
44300 MOVE 1,POSI+=8
44400 TLC 1,232000
44500 FADR 1,1
44550 CAMLE 1,ALF+=8
44600 JRST BS94
44800 ; 12100 IF(J10.GE.10)GO TO 7
44900 MOVEI 02,12
45000 CAMG 02,.COMM.+=31
45100 JRST BS7
45200
45300 ; 12200 C**********************
45400
45600 MOVE 3,.COMM.+=29 ; IF(J8.EQ.0)GO TO 94
45700 JUMPE 3,BS94
45800
45900 ; 12400 R3=RW
46100 MOVEM 4,.COMM.+4
46200
46300 ; 12500 IF(J9.EQ.0)GO TO 292
46400 MOVE 02,.COMM.+=30
46500 JUMPE 02,BS292
46600
46900 CAIL 3,24 ; IF(J8.GE.20)GO TO 193
47000 JRST BS193
47100
47200 ; 12700 293 RX=R3Q-RD
47300 BS293: MOVE 02,ALF+5
47400 FSBR 02,ALF+7
47500 MOVEM 02,ALF+=8
47600
47700 ; 12800 GO TO 194
47800 JRST BS194
47900
48000 ; 12900 7 RHX=RH-R3Q
48100 BS7: MOVN 02,ALF+5
48200 FADR 02,RH
48300 MOVEM 02,RHX#
48500 ; 13000 R3=RD-R3Q
48600 MOVN 02,ALF+5
49000 FADR 02,ALF+7
49100 MOVEM 02,.COMM.+4
49300 ; 13100 GO TO 292
49400 JRST BS292
49600 ; 13200 193 RX=RD-RA
49700 BS193: MOVE 02,ALF+7
49800 FSBR 02,BM
49900 MOVEM 02,ALF+=8
50100 ; 13300 194 R3=ABS(RX)
50200 BS194: MOVM ALF+=8
50400 MOVEM 00,.COMM.+4
50600 ; 13400 292 DISX=ABS(R3Q-RA)
50700 BS292: MOVE 02,ALF+5
50800 FSBR 02,BM
50900 MOVMM 02,ALF+=16
51400 ; 13500 HGT=RJX-RJY
51500 MOVE 3,ALF+=10
51600 FSBR 3,BM+2
51700 MOVEM 3,HGT#
51900 ; 13600 IF(J10.GE.10)HGT1=HGT*RHX/DISX
52000 MOVEI 02,12
52100 CAMLE 02,.COMM.+=31
52200 JRST BS10
52300 FMPR 3,RHX
52500 FDVR 3,ALF+=16
52600 MOVEM 3,HGT1#
53100 ; 13800 R3=R3/DISX
53200 BS10: MOVE 02,.COMM.+4
53300 FDVR 02,ALF+=16
53400 MOVEM 02,.COMM.+4
53600 ; 13900 195 HGT=HGT*R3
53700 MOVE 02,.COMM.+4
53800 FMPRB 02,HGT
54300 ; 14000 196 L=J8/10
54400 MOVE 4,.COMM.+=29
54500 IDIVI 4,12
54600 MOVEM 4,ALF+=12
54700
54800 ; 14100 J8=0
54900 SETZM .COMM.+=29
55000
55100 ; 14200 IF(J10.GE.10)GO TO 8
55200 MOVEI 3,12
55300 CAMG 3,.COMM.+=31
55400 JRST BS8
55800 CAIN 4,1 ; IF(L.EQ.1)GO TO 95
56100 JRST BS95
56300 ; C BEAM LFT=1, RT=2 (PARAM 8=10 OR 20)
56500 ; 14600 R3Q=RD
56600 MOVE 3,ALF+7
56700 MOVEM 3,ALF+5
56900 ; 14700 RJX=RJY+HGT
57100 FADR 02,BM+2 ; 2 WAS HGT
57200 MOVEM 02,ALF+=10
57400 ; 14800 GO TO 94
57500 JRST BS94
57900 ; 15000 8 R3Q=RH
58000 BS8: MOVE 02,RH
58100 MOVEM 02,ALF+5
58300 ; 15100 RA=RD
58400 MOVE 02,ALF+7
58500 MOVEM 02,BM
58700 ; 15200 RJY=RJX-HGT
58800 MOVE 02,ALF+=10
58900 FSBR 02,HGT
59000 MOVEM 02,BM+2
59200 ; 15300 RJX=RJX-HGT1
59600 MOVN 02,HGT1
59700 FADRM 02,ALF+=10
59900 ; 15400 GO TO 94
60000 JRST BS94
60200 ; 15500 95 RA=RD
60300 BS95: MOVE 02,ALF+7
60400 MOVEM 02,BM
60600 ; 15600 RJY=RJX-HGT
60700 MOVE 02,ALF+=10
60800 FSBR 02,HGT
60900 MOVEM 02,BM+2
61100 ; 15700 94 L=7.*RMINI
61200 BS94: MOVSI 02,203700
61300 FMPR 02,MIN+1
61400 JSA 16,IFIX
61500 JUMP 2
61600 MOVEM 00,ALF+=12
61800 ; 15800 930 RC=0
61900 BS930: SETZM BM+1
62100 ; C MINI LINES HAVE .2 SMALLER BEAMS. MAYBE CHANGE THIS??
62300 ; 16000 CALL LINES(R3Q,RJX,3)
62400 JSA 16,LINES
62500 JUMP ALF+5
62600 JUMP ALF+=10
62700 JUMP [3]
62900 ; 16100 DO 941 K=1,L
63000 MOVEI 15,1
63400 ; 16200 CALL BMS
63500 BS12: JSA 16,BMS
63700 ; 16300 IF(PLT.GE.0)GO TO 940
63800 MOVE 02,PLTR
63900 JUMPGE 02,BS940
64100 ; 16400 RC=RC+RY
64200 MOVE 02,RY
64300 FADRM 02,BM+1 ; FOR THICKENING.
65000 ; 16600 CALL BMS
65100 JSA 16,BMS
65300 MOVE 1,ALF+5 ; CALL EXCH(RA,ALF+5)
65500 EXCH 1,BM
65600 MOVEM 1,ALF+5
65700 MOVE 1,ALF+=10
65800 EXCH 1,BM+2 ; 941 CALL EXCH(RJY,RJX)
65900 MOVEM 1,ALF+=10
66200 CAMGE 15,ALF+=12
66300 AOJA 15,BS12
66500 ; 16900 CALL BMS
66600 JSA 16,BMS ; DRAWS 5 LINES FOR BEAMS.
67000 ; 17100 940 JJ2=JJ2-1
67100 BS940: SOSG POSI+=8
67300 ; 17200 IF(JJ2.LE.0)GO TO 942
67500 JRST BS942 ; IF P7=10 OR 20 ONE BEAM WILL APPEAR.
67900 ; 17400 RJY=RJY+RJ
68000 MOVE 02,ALF+=11
68100 FADRM 02,BM+2
68300 ; 17500 RJX=RJX+RJ
68500 FADRM 02,ALF+=10
68700 ; 17600 GO TO 930
68800 JRST BS930
69200 ; 17800 942 IF(R8.NE.0)RETURN
69300 BS942: SKIPN .COMM.+=9
69400 SKIPN .COMM.+=10
69500 JRA 16,(16)
69800 ; 17900 IF(R9.EQ.0)RETURN
70700 ; 18000 IF(R10.GE.30)RETURN
70800 MOVSI 02,205740
70900 CAMLE 02,.COMM.+=11
71000 JRA 16,(16) ; C FOR NUMBERS OUTSIDE BEAMS
71600 ; 18200 RSTJ2=RMINI
71700 MOVE 02,MIN+1
71800 MOVEM 02,STF+=8
72000 ; 18300 RD=-10.
72100 MOVN 3,[10.0]
72400 ; 18400 IF(R7.LT.20)RD=8.3
72500 MOVSI 02,205500
72600 CAMLE 02,.COMM.+=8
72800 MOVE 3,[8.3]
72900 MOVEM 3,ALF+7
73200 ; 18500 943 J3=R3Q+(RA-R3Q)/2.
73300 BS943: MOVN 02,ALF+5
73400 FADR 02,BM
73500 FSC 02,777777
73600 FADR 02,ALF+5
73700 JSA 16,IFIX
73800 JUMP 2
73900 MOVEM 00,.COMM.+=24
74100 ; 18600 R6=1.
74200 MOVSI 02,201400
74300 MOVEM 02,.COMM.+7
74320 ; 18900 R7=1
74420 MOVEM 02,.COMM.+=8 ; C ITALICS
74700 ; 18800 R4=R4+(R5-R4)/2.+RD
74800 MOVE 02,.COMM.+6
74900 FSBR 02,.COMM.+5
74910 FSC 02,777777
75000 FADR 2,ALF+7
75100 FADRM 02,.COMM.+5
76500 ; 19100 CALL MAKNUM(R9)
76600 JSA 16,MAKNUM
76700 JUMP .COMM.+=10
76900 JRA 16,(16) ; 19300 END
77000 END